;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "idraw.lisp")

(require "iimage.lisp")

(require "icommon.lisp")


(module MDraw
  (include-book "list-utilities" :dir :teachpacks)
  (include-book "avl-rational-keys" :dir :teachpacks)
  (import IImage)
  (import ICommon)
  

  
  ; takes the args list and returns the color specified within
  (defun getPixelFromArgs (args)
    (let ((shape (car args)))
      (cond
        ((string-equal shape "line")   (nthcdr 6 args))
        ((string-equal shape "filled-circle") (nthcdr 4 args))
        ((string-equal shape "border-circle") (nthcdr 5 args))
        ((string-equal shape "filled-rectangle") (nthcdr 5 args))
        ((string-equal shape "border-rectangle") (nthcdr 6 args))
        (t (princ$ "no getPixelFromArgs found"))
        )))
  ; see if the x y argument is within w/2 from the line connecting the points
  (defun check-line (x y args)
    (let* ((x1 (nth 1 args))
           (y1 (nth 2 args))
           (x2 (nth 3 args))
           (y2 (nth 4 args))
           (width (nth 5 args)))
      ;check for vertical line
      (if (= x1 x2)
          (and (> x (- x1 (/ width 2)))
               (<= x (+ x1 (/ width 2)))
               (or
                (and (>= y y1)
                     (<= y y2))
                (and (>= y y2)
                     (<= y y1))))
      (if (or
           (and (>= x (+ x1 (* (- y1 y) (/ (- y2 y1) (- x2 x1)))))
               (<= x (+ x2 (* (- y2 y) (/ (- y2 y1) (- x2 x1))))))
           (and (>= x (+ x2 (* (- y2 y) (/ (- y1 y2) (- x1 x2)))))
               (<= x (+ x1 (* (- y1 y) (/ (- y1 y2) (- x1 x2)))))))
          (> (square width)
              (* 4
                 (/ (square (- (* (- x2 x1) (- y1 y)) (* (- x1 x) (- y2 y1))))
                    (+ (square (- x2 x1)) (square (- y2 y1))))))
          ;(>= (square (/ width 2)) (min (+ (square (- x1 x)) (square (- y1 y)))
           ;              (+ (square (- x2 x)) (square (- y2 y))))))))
          nil))))
  
  (defun check-filled-circle (x y args)
    (let* ((x1 (nth 1 args))
           (y1 (nth 2 args))
           (r (nth 3 args)))
      (> (square r)
         (+ (square (- x x1))
            (square (- y y1))))))
  
  (defun check-border-circle (x y args)
    (let* ((x1 (nth 1 args))
           (y1 (nth 2 args))
           (r (nth 3 args))
           (w (nth 4 args))
           (d (+ (square (- x x1))
                 (square (- y y1)))))
      (and (> d
              (square (- r (/ w 2))))
           (< d
              (square (+ r (/ w 2)))))))
  
  (defun check-filled-rectangle (x y args)
    (let* ((x1 (nth 1 args))
           (y1 (nth 2 args))
           (x2 (nth 3 args))
           (y2 (nth 4 args)))
      (and (or (and (< x1 x) (> x2 x))
               (and (< x2 x) (> x1 x)))
           (or (and (< y1 y) (> y2 y))
               (and (< y2 y) (> y1 y))))))
  
  (defun check-border-rectangle (x y args)
    (let* ((x1 (nth 1 args))
           (y1 (nth 2 args))
           (x2 (nth 3 args))
           (y2 (nth 4 args))
           (w (nth 5 args))
           (w2 (/ w 2)))
      (or (and (or (and (< (- x1 w2) x) (> (+ x2 w2) x))
                   (and (< (- x2 w2) x) (> (+ x1 w2) x)))
               (or (and (< y (+ y1 w2)) (> y (- y1 w2)))
                   (and (< y (+ y2 w2)) (> y (- y2 w2)))))
          (and (or (and (< (- y1 w2) y) (> (+ y2 w2) y))
                   (and (< (- y2 w2) y) (> (+ y1 w2) y)))
               (or (and (< x (+ x1 w2)) (> x (- x1 w2)))
                   (and (< x (+ x2 w2)) (> x (- x2 w2))))))))
  
  ;takes a pixel and checks if it is within the shape and colors it
  (defun process-pixel (pixel x y args)
    (let* ((shape (car args)))
      (if (or 
           ; perform math for line
           (and (string-equal shape "line") (check-line x y args))
           (and (string-equal shape "filled-circle") (check-filled-circle x y args))
           (and (string-equal shape "border-circle") (check-border-circle x y args))
           (and (string-equal shape "filled-rectangle") (check-filled-rectangle x y args))
           (and (string-equal shape "border-rectangle") (check-border-rectangle x y args))
           )
          ; we have a match, return new color
          (getPixelFromArgs args)
          ;return origional color
          pixel)))
  
  
  
  ;takes a row tree and checks every pixel
  (defun process-row (row args x y width)
    (if (> x width)
        row
        (process-row (avl-insert row x (process-pixel (cdr (avl-retrieve row x)) x y args)) args (+ x 1) y width)))
  
  ; internal crop function, loops over every row.
  (defun draw-int (tree args y)
    (if (> y (getHeight tree))
        tree
        (draw-int (avl-insert tree y (process-row (cdr (avl-retrieve tree y)) args 1 y (getWidth tree))) args (+ y 1))))
  
  
  ; public accessible crop function, takes in the tree, parses args
  ; also takes care of errors in the args
  (defun MainDraw (tree args)
    ;    (princ$ "got to int"))
    (let* ((shape (car args)))
      (if 
       ; check to see if the shape is a string
       (and (stringp shape)
            ; see if we have valid arguments for one of our draw functions
            (or 
             ; check for valid line
             (and (string-equal shape "line")
                  ; two valid points
                  (validPoint (nth 1 args) (nth 2 args) (getWidth tree) (getHeight tree))
                  (validPoint (nth 3 args) (nth 4 args) (getWidth tree) (getHeight tree))
                  ; a valid width
                  (natp (nth 5 args))
                  ; a valid color
                  (validPixel (nthcdr 6 args)))
             (and (string-equal shape "filled-circle")
                  (validPoint (nth 1 args) (nth 2 args) (getWidth tree) (getHeight tree))
                  (natp (nth 3 args))
                  (validPixel (nthcdr 4 args)))
             (and (string-equal shape "border-circle")
                  (validPoint (nth 1 args) (nth 2 args) (getWidth tree) (getHeight tree))
                  (natp (nth 3 args))
                  (natp (nth 4 args))
                  (validPixel (nthcdr 5 args)))
             (and (string-equal shape "filled-rectangle")
                  ; two valid points
                  (validPoint (nth 1 args) (nth 2 args) (getWidth tree) (getHeight tree))
                  (validPoint (nth 3 args) (nth 4 args) (getWidth tree) (getHeight tree))
                  ; a valid color
                  (validPixel (nthcdr 5 args)))
             (and (string-equal shape "border-rectangle")
                  ; two valid points
                  (validPoint (nth 1 args) (nth 2 args) (getWidth tree) (getHeight tree))
                  (validPoint (nth 3 args) (nth 4 args) (getWidth tree) (getHeight tree))
                  ; a valid width
                  (natp (nth 5 args))
                  ; a valid color
                  (validPixel (nthcdr 6 args)))
             ))
       ; if valid, process tree
       (mv (draw-int tree args 1) (list "Draw completed sucessfully"))
       ; else return error
       (mv tree (list "Draw Error: Invalid arguments. Valid Options:"
                      "draw line <p1 x> < p1 y> < p2 x> < p2 y> <width w> <color r> <color g> <color b>"
                      "draw filled-rectangle <upper_left x> <upper_left y> <lower_right x> <lower_right y> <fill_color r> <fill_color g> <fill_color b>"
                      "draw border-rectangle <upper_left x> <upper_left y> <lower_right x> <lower_right y> <border_width> <fill_color r> <fill_color g> <fill_color b>"
                      "draw filled-circle <center x> <center y> <radius r> <fill_color r> <fill_color g> <fill_color b>"
                      "draw border-circle <center x> <center y> <radius r> <border_width w> <fill_color r> <fill_color g> <fill_color b>")))))
  
  (export IDraw))